home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / misc / amag / sh9301c.lha / Oberon(S.67) / Listing15.mod < prev    next >
Text File  |  1993-01-22  |  2KB  |  74 lines
  1. MODULE MiniPaint;
  2. IMPORT
  3.   I: Intuition, rq: Requests, s: SYSTEM, d: Dos, e: Exec, g: Graphics;
  4. CONST
  5.   Version = "$VER: MiniPaint 1.00 (10-Jul-91)\n\r";
  6.   (* Für den Version-Befehl von OS 2.0 ! Example: "Version MiniPaint" *)
  7. VAR
  8.   nw: I.NewWindow;
  9.   Win: I.WindowPtr;
  10.   IMsg: I.IntuiMessagePtr;
  11.   Draw, Quit: BOOLEAN;
  12.   Class: LONGSET;
  13.   Code: INTEGER;
  14.   OldX, OldY, X, Y, Color: INTEGER;
  15. PROCEDURE Cut (VAR i: INTEGER; Min, Max: INTEGER);
  16. BEGIN
  17.   IF i < Min THEN i := Min END;
  18.   IF i > Max THEN i := Max END;
  19. END Cut;
  20. BEGIN
  21.   Draw := FALSE; Quit := FALSE; Color := 1;
  22.   nw := I.NewWindow (100, 75, 300, 100, 0, 1, LONGSET {I.mouseButtons,
  23.                      I.mouseMove, I.closeWindow}, LONGSET {I.rmbTrap,
  24.                      I.reportMouse, I.windowDrag, I.sizeBRight, I.activate,
  25.                      I.windowSizing, I.windowDepth, I.windowClose},
  26.                      NIL, NIL, s.ADR ("MiniPaint v1.00"), NIL,
  27.                      NIL, 150, 50, -1, -1, SET {I.wbenchScreen});
  28.   Win := I.OpenWindow (nw);
  29.   rq.Assert (Win # NIL, "Sorry, no Window");
  30.   g.SetDrMd (Win^.rPort, g.jam1);
  31.   g.SetAPen (Win^.rPort, Color);
  32.   REPEAT
  33.     e.WaitPort (Win^.userPort);
  34.     LOOP
  35.       IMsg := e.GetMsg (Win^.userPort);
  36.       IF IMsg = NIL THEN EXIT END;
  37.       Class := IMsg^.class;
  38.       Code := IMsg^.code;
  39.       X := IMsg^.mouseX;
  40.       Cut (X, Win^.borderLeft+1, Win^.width-Win^.borderRight-2);
  41.       Y := IMsg^.mouseY;
  42.       Cut (Y, Win^.borderTop+1, Win^.height-Win^.borderBottom-2);
  43.       e.ReplyMsg (IMsg);
  44.       IF (I.mouseButtons IN Class) THEN
  45.         CASE Code OF
  46.         | I.selectUp:
  47.           Draw := FALSE;
  48.         | I.selectDown:
  49.           Draw := TRUE;
  50.           OldX := X; OldY := Y;
  51.           IF g.WritePixel (Win^.rPort, X, Y) THEN END;
  52.           g.Move (Win^.rPort, X, Y);
  53.         | I.menuUp:
  54.           INC (Color);
  55.           IF Color > ASH (1, Win^.wScreen^.bitMap.depth)-1 THEN
  56.             Color := 0;
  57.           END; (* IF *)
  58.           g.SetAPen (Win^.rPort, Color); (* Farbe einstellen *)
  59.         ELSE
  60.         END; (* CASE *)
  61.       ELSIF (I.mouseMove IN Class) THEN
  62.         IF ((OldX # X) OR (OldY # Y)) AND Draw THEN
  63.           OldX := X; OldY := Y; (* Um nicht 1 Pixel lange Linien zu zeichnen *)
  64.           g.Draw (Win^.rPort, X, Y);
  65.         END; (* IF *)
  66.       ELSIF (I.closeWindow IN Class) THEN
  67.         Quit := TRUE; (* und tschüß! *)
  68.       END; (* IF *)
  69.     END; (* LOOP *)
  70.   UNTIL Quit;
  71. CLOSE
  72.   IF Win # NIL THEN I.CloseWindow (Win); Win := NIL END;
  73. END MiniPaint.
  74.